COMMENT ⊗   VALID 00011 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	BEGOF("TEMPL")
C00004 00003	PUBLIC SIMPLE PROCEDURE TEMPL! $"#
C00005 00004	PUBLIC RECURSIVE PROCEDURE APPLYTOARGUMENTS(BOOLEAN DO!IT, PROCALL) $"#
C00009 00005	PUBLIC SIMPLE PROCEDURE DDONE(BOOLEAN RETURNS) $"#
C00012 00006	PUBLIC STRING SIMPLE PROCEDURE DEFN(BOOLEAN SUBSTVARIABLES,FORFILE INTEGER ARGS, IBASE) $"#
C00019 00007	PUBLIC SIMPLE PROCEDURE DMACRO(INTEGER ODDONE) $"#
C00022 00008	PUBLIC SIMPLE PROCEDURE DREPEAT $"#
C00023 00009	PUBLIC RECURSIVE STRING PROCEDURE PROCSTATEMENT $"#
C00024 00010	PUBLIC SIMPLE PROCEDURE WARNLONG(STRING SEGM, MESG) $"#
C00025 00011	FINISHED
C00026 ENDMK
C⊗;
BEGOF("TEMPL")

COMMENT

MACROs, PROCEDUREs, REPEATs, counter and response templates. If you
don't find here what you are looking for, try file RESPS for
responses, SORCE for source switching, CNTRS for counters.

;

PROCEDURES
PUBLIC SIMPLE PROCEDURE TEMPL! ;$"#
BEGIN "TEMPL!"
MAXTEMPLATE ← 5000 ; TES 8/19/74 ;
END "TEMPL!" ;
PUBLIC RECURSIVE PROCEDURE APPLYTOARGUMENTS(BOOLEAN DO!IT, PROCALL) ;$"#
BEGIN TES 8/19/74 EXTRACTED FROM PASS TO HANDLE PROCEDURES AS WELL AS MACROS ;
BOOLEAN WASLPAR, DUMSEMI ;
INTEGER MACIX, MACSYM, ARGS, ARG, ARGSYM, NAMES, K ;
MACIX ← IX ; MACSYM ← SYMB ; ARGS ← NUMARGS(MACIX) ; DUMSEMI ← FALSE ;
IF ARGS THEN
	BEGIN "SCAN ARGS"
	STRING ARRAY ACTUAL[1:ARGS] ;
	IF  NOT (WASLPAR ← NEXTSCH(<(>)) THEN INPUTSTR ← LIT!ENTITY&LIT!TRAIL&INPUTSTR ;
	comment , Back up. Pretend just passed comma. ; THISWD ← "," ; EMPTYTHAT ;
	NAMES ← NAMEPAR(MACIX) ; comment bit table for name parameters ;
	FOR ARG ← 1 THRU ARGS DO
		BEGIN "EACH ACTUAL"
		IF  NOT ITSCH(<,>) THEN ACTUAL[ARG] ← NULL comment , omitted argument;
		ELSE	BEGIN	RD(TO!VISIBLE) ;
			IF NAMES LAND TWO(ARGS-ARG) = 0 THEN
				BEGIN PASS ; ACTUAL[ARG] ← E(NULL, NULL&'0) ; END
			ELSE	BEGIN "CALL BY NAME"
				IF BRC NEQ """" THEN
				 BEGIN comment , Unquoted Call-By-Name ;
				 IF (K←BRC)="|" THEN RD(ONE!CHAR) ;
				 ACTUAL[ARG]←RD(IF K="|" THEN TO!VBAR!SKIP
					ELSE IF WASLPAR THEN TO!COMMA!RPAR ELSE TO!TERQ!CR) ;
				 IF BRC=CR AND  NOT WASLPAR THEN
					BEGIN comment force a semicolon ;
					INPUTSTR ← ";" & INPUTSTR ;
					DUMSEMI ← TRUE ;
					END ;
				 PASS ;
				 END
				ELSE	BEGIN PASS ; ACTUAL[ARG]←E(NULL,0) END ;
				END "CALL BY NAME"
			END
		END "EACH ACTUAL" ;
	WHILE ITSCH(<,>) DO
		BEGIN
		WARN("=",<"Too Many Arguments to "&SYM[MACSYM]>) ;
		PASS ; E(NULL, 0) ;
		END ;
	IF ITSCH(<)>) AND WASLPAR THEN BEGIN comment  Easy case; END
	ELSE	BEGIN
		IF WASLPAR THEN WARN("=",<"Missed ) After Macro Call">) ;
		comment Back Up -- SWICH only saves THATWD ;
		IF THATISFULL THEN comment Unlikely; INPUTSTR ← LIT!ENTITY&LIT!TRAIL&INPUTSTR ;
		IF THISISFULL AND  NOT DUMSEMI THEN BEGIN THATWD ← LIT!ENTITY ← THISWD ;
			LIT!TRAIL ← IF THISTYPE<-1 THEN NULL ELSE SP ;
			THATTYPE ← THISTYPE MIN 0 END ELSE EMPTYTHAT ;
		END ;
	IF PROCALL THEN SWICH("RETURN(NULL);;",-2-BLNMS,0) ; TES 8/20/74 ;
	IF DO!IT THEN
		BEGIN "STACK ARGUMENTS"
		IF LAST + ARGS > SIZE THEN GROWNESTS ;
		FOR ARG ← 1 THRU ARGS DO
			SNEST[LAST + ARG] ← ACTUAL[ARG] ;
		LAST ← LAST + ARGS ; 
		END "STACK ARGUMENTS" ;
	END "SCAN ARGS" ;
IF PROCALL AND NOT ARGS THEN SWICH("RETURN(NULL);;",-2-BLNMS,0) ; TES 8/20/74 ;
IF DO!IT THEN SWICH(SSTK[BODY(MACIX)], -1, ARGS)
ELSE BEGIN THISWD ← "7" ; THISTYPE ← -1 END ; COMMENT, Replace by NULL ("") ;
END "APPLYTOARGUMENTS" ;
PUBLIC SIMPLE PROCEDURE DDONE(BOOLEAN RETURNS) ;$"#
BEGIN TES 8/14/74 (DONE) 8/19/74 (RETURN);
INTEGER B ; STRING VAL ; BOOLEAN GOT ;
PASS ;
IF ON THEN
IF NOT RETURNS AND DEEPREPEATS=0 THEN WARN(NULL,"Ignored a DONE without a repeat")
ELSE IF RETURNS AND DEEPPROCEDURES=0 THEN WARN(NULL, "Ignored a RETURN not in a PROCEDURE")
ELSE
BEGIN
IF RETURNS THEN
	BEGIN
	DEEPPROCEDURES ← DEEPPROCEDURES - 1 ;
	IF ITSCH(<(>) THEN
		BEGIN COMMENT VALUE TO RETURN ;
		PASS ;
		VAL ← E(NULL, NULL) ;
		IF NOT ITSCH(<)>) THEN WARN(NULL, <"Missed ) after RETURN">) ;
		END
	ELSE VAL ← NULL ;
	END
ELSE DEEPREPEATS ← DEEPREPEATS - 1 ;
EMPTYTHIS ; EMPTYTHAT ; INPUTSTR ← NULL ;
DO	BEGIN
	WHILE LAST AND CHANSCAN(LAST) > -2 DO
		INPUTSTR ← SWICHBACK ;
	GOT ← RETURNS EQV EQU("RETURN(", STRSCAN(LAST)[1 TO 7]) ;
	STRSCAN(LAST) ← NULL ;
	IF NOT GOT THEN CHANSCAN(LAST)←-1 ;
	END UNTIL GOT ;
B ← -2 - CHANSCAN(LAST) ;
WHILE B<BLNMS DO
	CASE IF STARTS THEN 0 ELSE ENDCASE OF
		BEGIN
		BEGIN BLNMS←BLNMS-1 ; STARTS←STARTS-1 ; END ;
		BEGIN BLNMS←BLNMS-1 ; IF ENDBLOCK THEN WARN("=","Missed END")  END ;
		IF ENDBLOCK THEN WARN("=", "Missed END") ELSE
			BEGIN BLNMS←BLNMS-1 ; IF ENDBLOCK THEN WARN("=","Missed END")  END ;
		BEGIN BLNMS←BLNMS-1 ; IF ENDBLOCK THEN MYEND ← TRUE ELSE WARN("=","Extra END") END ;
		END ;
CHANSCAN(LAST) ← -1 ;
INPUTSTR ← SWICHBACK ;
PASS ;
IF RETURNS THEN PROCVALUE ← VAL ;
END ;
END "DDONE" ;
PUBLIC STRING SIMPLE PROCEDURE DEFN(BOOLEAN SUBSTVARIABLES,FORFILE; INTEGER ARGS, IBASE) ;$"#
BEGIN
STRING SEGMENT, IDENT, PSPCS, SPCS, FML, TXID, TX2 ;
INTEGER SINDX, I, DEEP, PGMKS, REQRS ;
LABEL FORMAL ;
IF ITSCH(;) THEN PASS ; DEFINING ← NOT FORFILE ; comment, makes RD include line nos in result ;
IF  NOT ITSCH(⊂) AND NOT(ITSCH($) AND NEXTSCH(<(>))
	THEN BEGIN WARN("=",<"Missed Horseshoe, ↑P,  OR $( in definition">) ; RETURN(NULL) END ;
DEEP ← 1 ; SINDX ← SHIGH ;
IF SHIGH+20>STSIZE THEN
	BEGIN
	SGROW(STBL,STBLIDA,STSIZE,100,"Definition") ;
	SMAKEBE(STBLIDA, STBL) ; ZEROSTRINGS(100, STBL[STSIZE-99]) ;
	END ;
EMPTYTHIS ; comment For page label switch in LABELREF ;
IF FORFILE THEN STBL[SINDX←SINDX+1] ← SRCLINE & "/" & SRCPAGE & TB & ALTMODE ;
IF EQU(INPUTSTR[1 for 2], RCBRAK&VT) THEN
	BEGIN
	STBL[SINDX ← SINDX + 1] ← CRLF & SRCLINE & "/" & SRCPAGE & TB ;
	INPUTSTR ← INPUTSTR[3 for ∞] ;
	END ;
PGMKS ← PAGEMARKS ; REQRS ← LAST ; TES 8/19/74 ;
WHILE DEEP DO
	BEGIN "DEF BODY"
	SEGMENT ← RD(DEFN!TABLE) ;
	IF BRC = "⊂" OR BRC="$" AND INPUTSTR="(" AND LOP(INPUTSTR)="(" THEN
		BEGIN DEEP ← DEEP + 1 ; SEGMENT ← SEGMENT & "⊂" ; END
	ELSE IF BRC = "⊃" OR BRC=")" AND INPUTSTR="$" AND LOP(INPUTSTR)="$" THEN
		BEGIN DEEP ← DEEP - 1 ;
		SEGMENT ← SEGMENT & (IF DEEP THEN "⊃" ELSE SP) ;
		END
	ELSE IF BRC = "∃" THEN SEGMENT ← SEGMENT & (IF DEEP>1 THEN BRC ELSE NULL) & RD(ONE!CHAR)
	ELSE IF LENGTH(TXID←BRC)  AND 
		(LDB(SPCODE(BRC))=LCURLY  OR 
		 LDB(SPCODE(BRC))=DOLLAR AND LDB(SPCODE(INPUTSTR))=LBRACK  AND 
			LENGTH(TXID←TXID&LOP(INPUTSTR))) THEN
		IF SUBSTVARIABLES THEN
		BEGIN "{..."
		SPCS ← TXID & RD(TO!VISIBLE) ;
		IDENT ← SCAN(INPUTSTR,ALPHA,DUMMY) ; PSPCS ← RD(TO!VISIBLE) ;
		IF BRC = RCBRAK OR BRC="]" AND INPUTSTR[2 FOR 1]="$"THEN
			BEGIN
			LOPP(INPUTSTR) ;
			IF BRC="]" THEN BEGIN TX2←"]$" ; LOPP(INPUTSTR) END ELSE TX2←RCBRAK ;
			SEGMENT ← SEGMENT &
			(IF FULSTR(IDENT) AND SIMLOOK(CAPITALIZE(IDENT))
			 AND SYMTYPE<MACROTYPE THEN  TES 11/29/73 ;
				IF SYMIX=IXPAGE THEN ALTMODE&"[@]"&
				 LABELREF(0,
					IF SYMBOL=SYMPAGE THEN CTR!CHRS(IXPAGE)
					ELSE PATT!CHRS(IXPAGE))
				ELSE EVALV(IDENT, SYMIX, SYMTYPE)
			ELSE SPCS & IDENT & PSPCS & TX2)
			END
		ELSE SEGMENT ← SEGMENT & SPCS & IDENT & PSPCS ;
		END "{..."
		ELSE SEGMENT ← SEGMENT & TXID
	ELSE IF BRC = RCBRAK THEN
		IF EQU(INPUTSTR[1 for 2], RCBRAK&VT) THEN ELSE SEGMENT ← SEGMENT & BRC
	ELSE IF LDB(FAMILY(BRC)) = LETTQ THEN
		BEGIN "LETTER"
		IDENT ← (BRC+0) & SCAN(INPUTSTR, ALPHA, BRC) ;
		FOR I ← 1 THRU ARGS DO IF EQU(FML←SYM[ITBL[IBASE+I]], TXID←CAPITALIZE(IDENT)) THEN
				FORMAL: BEGIN IDENT ← VT & I ; DONE END
			ELSE IF 1 LEQ LENGTH(TXID)-LENGTH(FML) LEQ 2 THEN
				BEGIN "MAYBE UNDERLINED"
				INTEGER L, R ;
				L ← IF IDENT="_" THEN 1 ELSE 0 ; R ← IF IDENT[∞ FOR 1]="_" THEN 1 ELSE 0 ;
				IF EQU(FML, TXID[1+L TO ∞-R]) THEN
					BEGIN
					IF L THEN SEGMENT ← SEGMENT & "_" ;
					IF R THEN INPUTSTR ← "_" & INPUTSTR ;
					GO TO FORMAL ;
					END ;
				END "MAYBE UNDERLINED" ;
		SEGMENT ← SEGMENT & IDENT ;
		END "LETTER"
	ELSE SEGMENT ← SEGMENT & BRC ;
	STBL[SINDX ← SINDX+1] ← SEGMENT ; 
	IF SINDX = SHIGH+20 THEN
		BEGIN
		SEGMENT ← STBL[SHIGH + 1] ;
		FOR I ← SHIGH + 2 THRU SINDX DO BEGIN SEGMENT ← SEGMENT & STBL[I] ; STBL[I]←NULL; END;
		SINDX ← SHIGH + 1 ; STBL[SINDX] ← SEGMENT ;
		IF DEEP THEN TES 8/19/74 CHECK FOR INFINITE TEMPLATE ;
			IF LENGTH(SEGMENT) > MAXTEMPLATE THEN
				BEGIN
				WARNLONG(SEGMENT, "A template is longer than " &
    				CVS(MAXTEMPLATE) & " characters" & CRLF &
    				"If you really have such a long one, increase the value of maxtemplate") ;
				STBL[SINDX] ← NULL ; DONE ;
				END
			ELSE IF PAGEMARKS > PGMKS THEN
				BEGIN
				WARNLONG(SEGMENT,
					"A template crosses a manuscript page mark (form feed)") ;
				STBL[SINDX] ← NULL ; DONE ;
				END
			ELSE IF LAST NEQ REQRS THEN
				BEGIN
				WARNLONG(SEGMENT, "A template crosses a file boundary (eof)") ;
				STBL[SINDX] ← NULL ; DONE ;
				END ;
		END ;
	END "DEF BODY" ;
SEGMENT ← STBL[SHIGH+1] ; FOR I ← SHIGH+2 THRU SINDX DO SEGMENT ← SEGMENT & STBL[I] ;
IF FORFILE THEN SEGMENT ← SEGMENT & LF ;
 DEFINING ← FALSE ; INPUTSTR ← ";" & INPUTSTR ; PASS ;
RETURN(SEGMENT) ;
END "DEFN" ;
PUBLIC SIMPLE PROCEDURE DMACRO(INTEGER ODDONE) ;$"#
TES 8/19/74 ODDONE= 0:RECURSIVE MACRO 1:MACRO 2:PROCEDURE;
BEGIN COMMENT, OLD VERSION NOT GARBAGED BUT COULD BE ;
INTEGER SIHIGH, MIX, ARGS, J, NAMES, NAME ; BOOLEAN ROTTEN ;
SIHIGH ← IHIGH ; DPASS ; IF  NOT THISISID THEN BEGIN WARN("=","Macro name not identifier") ; RETURN END ;
IF THATISID THEN BEGIN "TWO WORD" THISWD ← THISWD & SP & THATWD ; RDENTITY ; END "TWO WORD" ;
PUTI(1, SYMNUM(THISWD)) ; PASS ;
IF ITSCH(<(>) THEN
BEGIN "FORMALS"
ROTTEN ← FALSE ; THISWD ← "," ; NAMES ← 0 ;
DO	BEGIN
	IF ITSCH(<,>) THEN DPASS
	ELSE BEGIN WARN("=","Missed comma in macro formal list") ; ROTTEN←TRUE END ;
	IF ITSCH(ε) THEN BEGIN DPASS ; NAME ← 0 ; END ELSE NAME ← 1 ;
	IF  NOT THISISID THEN BEGIN WARN("=","Formal parameters must be identifiers") ; ROTTEN←TRUE END
	ELSE BEGIN PUTI(1, SYMB) ; NAMES ← 2*NAMES + NAME ; DPASS END ;
	END
UNTIL ITSCH(<)>) OR ROTTEN ;
IF ITSCH(<)>) THEN PASS ;
END "FORMALS" ;
IF ROTTEN OR  NOT ON THEN BEGIN IHIGH ← SIHIGH ; DEFN(FALSE, FALSE,0,0) ; RETURN END ;
ARGS ← IHIGH - SIHIGH - 1 ; BIND(DECLARE(ITBL[SIHIGH+1], MACROTYPE), MIX←PUSHI(MACROWDS,MACROTYPE)) ;
NUMARGS(MIX) ← ARGS ; ODDMAC(MIX) ← ODDONE ; BODY(MIX) ← PUSHS(1,DEFN(FALSE, FALSE,ARGS,SIHIGH+1)) ;
IHIGH ← SIHIGH ; NAMEPAR(MIX) ← NAMES ;
END "DMACRO" ;
PUBLIC SIMPLE PROCEDURE DREPEAT ;$"#
BEGIN TES 8/14/74 ;
STRING BOD ;
PASS ;
BOD ← DEFN(FALSE, FALSE, 0, 0) ;
IF ON THEN
	BEGIN
	DEEPREPEATS ← DEEPREPEATS + 1 ;
	SWICH(BOD, -2-BLNMS, 0) ;
	SWICH(BOD, -1, 0) ;
	PASS ;
	END ;
END "DREPEAT" ;
PUBLIC RECURSIVE STRING PROCEDURE PROCSTATEMENT ;$"#
    IF THISTYPE = MACROTYPE THEN
	IF ODDMAC(IX)<2 THEN WARN(NULL,<"Unexpanded MACRO "&THISWD&" (PUB Bug)">)
	ELSE IF ON THEN
		BEGIN
		INTEGER PR ;
		PR←DEEPPROCEDURES←DEEPPROCEDURES+1;
		APPLYTOARGUMENTS(TRUE, TRUE);
		DO STATEMENT UNTIL DEEPPROCEDURES<PR;
		RETURN(TRUE) ;
		END
	ELSE	BEGIN
		APPLYTOARGUMENTS(FALSE, FALSE) ;
		RETURN(TRUE) ;
		END
    ELSE RETURN(FALSE) ;
PUBLIC SIMPLE PROCEDURE WARNLONG(STRING SEGM, MESG) ;$"#
	WARN(NULL, <MESG & CRLF &
		"[You probably omitted a template closer: )$ or ↑P or Horseshoe]"
		& CRLF & "The template began with:" & CRLF & SEGM[1 TO 70]>) ;
FINISHED

ENDOF("TEMPL")